home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_2 / star-1_0.tar / hp48.star < prev    next >
Text File  |  1991-03-22  |  7KB  |  467 lines
  1. ;;
  2. ;;   HP-48SX Standard Macro Library
  3. ;;   Copyright (C) 1990 Jan Brittenson
  4. ;;
  5.  
  6.     save list
  7.     list=0
  8.     if pass == 1 && !def hp48loaded
  9.  
  10. ;;
  11. ;; This file is part of STAR, the Saturn Macro Assembler.
  12. ;; 
  13. ;;    STAR is not distributed by the Free Software Foundation. Do not ask
  14. ;; them for a copy or how to obtain new releases. Instead, send e-mail to
  15. ;; the address below. STAR is merely covered by the GNU General Public
  16. ;; License.
  17. ;; 
  18. ;; Please send your comments, ideas, and bug reports to
  19. ;; Jan Brittenson <bson@ai.mit.edu>
  20. ;; 
  21.  
  22. ;;
  23. ;; Copyright (C) 1990 Jan Brittenson.
  24. ;; 
  25. ;;    STAR is free software; you can redistribute it and/or modify it
  26. ;; under the terms of the GNU General Public License as published by the
  27. ;; Free Software Foundation; either version 1, or (at your option) any
  28. ;; later version.
  29. ;; 
  30. ;;    STAR is distributed in the hope that it will be useful, but WITHOUT
  31. ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  32. ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
  33. ;; for more details.
  34. ;; 
  35. ;;    You should have received a copy of the GNU General Public License
  36. ;; along with STAR; see the file COPYING. If not, to obtain a copy, write
  37. ;; to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139,
  38. ;; USA, or send e-mail to bson@ai.mit.edu.
  39. ;;
  40.  
  41. ; HP-48SX Type prefixes
  42.  
  43.     type_type = x'28fc
  44.     type_real = x'2933
  45.     type_complex = x'2977
  46.     type_string = x'2a2c
  47.     type_array = x'29e8
  48.     type_list = x'2a74
  49.     type_global = x'2e48
  50.     type_local   = x'2e6d
  51.     type_program = x'2d9d
  52.     type_algebraic = x'2ab8
  53.     type_binary = x'2a4e
  54.     type_grob = x'2b1e
  55.     type_tagged = x'2afc
  56.     type_unit = x'2ada
  57.     type_xlib = x'2e92
  58.     type_function = x'2e92
  59.     type_command = x'2e92
  60.     type_directory = x'2a96
  61.     type_library = x'2b40
  62.     type_backup = x'2b62
  63.     type_address = x'2911
  64.     type_short = x'2911
  65.     type_longreal = x'2955
  66.     type_longcomplex = x'299d
  67.     type_linkedarray = x'2a0a
  68.     type_character = x'29bf
  69.     type_code = x'2dcc
  70.     type_librarydata = x'2b88
  71.     type_2baa = x'2baa
  72.     type_2bcc = x'2bcc
  73.     type_2bee = x'2bee
  74.     type_2c10 = x'2c10
  75.     type_user1 = type_2baa
  76.     type_user2 = type_2bcc
  77.     type_user3 = type_2bee
  78.     type_user4 = type_2c10
  79.  
  80.     hide    type_type, type_real, type_complex, type_string
  81.     hide    type_array, type_list, type_global, type_local
  82.     hide    type_program, type_algebraic, type_binary, type_grob
  83.     hide    type_tagged, type_unit, type_xlib, type_function
  84.     hide    type_command, type_directory, type_library, type_backup
  85.     hide    type_address, type_short, type_longreal, type_longcomplex
  86.     hide    type_linkedarray, type_character, type_code, type_librarydata
  87.     hide    type_2baa, type_2bcc, type_2bee, type_2c10
  88.     hide    type_user1, type_user2, type_user3, type_user4
  89.  
  90.     Array = type_array
  91.     List = type_List
  92.     Prg = type_program
  93.     Algebraic = type_algebraic
  94.     Unit = type_unit
  95.     Dir = type_directory
  96.  
  97.     hide    Array, List, Prg, Algebraic, Unit, Dir
  98.  
  99. ; Address map
  100.     
  101.     static     0, x'6ffff
  102.     floating x'70000, x'fffff
  103.  
  104.  
  105. ; Some useful symbols and macros
  106.  
  107.     false=0
  108.     true=!false
  109.  
  110.     hide false, true
  111.  
  112.     ; Display type warnings if enabled
  113.  
  114.     warnings=true
  115.  
  116.     macro warning    message=`'
  117.       if warnings
  118.         error Warning - $message
  119.        endif
  120.     endmacro
  121.  
  122.     hide    warning, warnings
  123.  
  124.     ; EQU-style assignment
  125.  
  126. sym:    macro equ    value=0
  127.     
  128.     value=$value
  129.  
  130.     if sym == `'
  131.       error Bad EQU statement - missing symbol
  132.     else
  133.       if typeof value != 1
  134.         warning Possibly nonportable EQU statement
  135.       endif
  136.       $sym = value
  137.     endif
  138.  
  139.     endmacro
  140.  
  141.     hide    equ
  142.  
  143.     ; Enable listing of block
  144.  
  145.     macro listblock
  146.       save list
  147.       list = 1
  148.       hide list
  149.     endmacro
  150.  
  151.     hide    listblock
  152.  
  153.     ; Disable listing of block
  154.  
  155.     macro nlistblock
  156.       save list
  157.       list = 0
  158.       hide list
  159.     endmacro
  160.  
  161.     hide    nlistblock
  162.  
  163.     ; End of list block
  164.  
  165.     macro endlist
  166.       restore list
  167.       hide list
  168.     endmacro
  169.  
  170.     hide    endlist
  171.  
  172.  
  173. ; Compute address of operand.
  174. ; For clarity, no defaults are defined.
  175.  
  176.   macro    addr    operand, dest
  177.  
  178.     save    sym, tmp, ntmp
  179.     sym  = gensym
  180.  
  181.     dest = uc^`$dest'
  182.  
  183.     if `$dest' == `A'
  184.       tmp = `C'
  185.       ntmp= `A'
  186.     else
  187.       tmp = `A'
  188.       ntmp= `C'
  189.     endif
  190.  
  191.     move    pc, $tmp
  192.     $sym = .
  193.  
  194.     if (`$dest' == `D0') || (`$dest' == `D1')
  195.       move.5 ($operand)-$sym, $dest
  196.       swap    $ntmp, $dest
  197.       add.a   $tmp, $ntmp
  198.       swap    $ntmp, $dest
  199.     else
  200.       move.p5 ($operand)-$sym, $dest
  201.       add.a   $tmp, $dest
  202.     endif
  203.     
  204.     restore    tmp, ntmp, sym
  205.  
  206.   endmacro
  207.  
  208.     hide    addr
  209.  
  210. ; Standard kermit preamble
  211.  
  212.     macro header rom_ver=``D''
  213.  
  214.     if pass == 3
  215.     rom_ver = uc^$rom_ver
  216.  
  217.     if typeof rom_ver != 2
  218.       warning `$rom_ver' is not a string
  219.     endif
  220.  
  221.     ascii    `HPHP48-'
  222.     data.b    rom_ver
  223.     else
  224.     data.b    0,0,0,0,0,0,0,0
  225.     endif
  226.     endmacro
  227.  
  228.     hide    header
  229.  
  230.  
  231. ; RPL block
  232. ; Read a block of code and apply data.a operator to it.
  233. ;
  234. ;    RPL
  235. ;      ...body...
  236. ;    ENDRPL
  237.  
  238.     macro    __rpl    arg=``0''
  239.       arg = $arg
  240.       if arg l% 1 == `_'
  241.         $(arg r% 2)
  242.       else
  243.         data.a  $arg
  244.       endif
  245.     endmacro
  246.  
  247.     macro    rpl
  248.       doblock __rpl, `ENDRPL'
  249.     endmacro
  250.  
  251.     hide    __rpl, rpl
  252.  
  253.  
  254. ; Type Code (CODE block)
  255. ; Read a block of code, apply null to it, and build code data.
  256. ;
  257. ;    CODE
  258. ;      ...ml body...
  259. ;    ENDCODE
  260.  
  261.     macro    __code    arg=``''
  262.     arg = $arg
  263. $arg
  264.     endmacro
  265.  
  266.  
  267.     macro    code
  268.       save    beginsym, endsym
  269.  
  270.       beginsym = gensym
  271.       endsym = gensym
  272.  
  273.       data.a  type_code
  274.  
  275.       $beginsym = .
  276.       data.a  $endsym-$beginsym
  277.  
  278.       doblock  __code, `ENDCODE'
  279.  
  280.       $endsym = .
  281.  
  282.       restore  beginsym, endsym
  283.     endmacro
  284.  
  285.     hide    __code, code
  286.  
  287. ; XLIB function ref
  288. ;     FUNCTION  major, minor
  289. ;
  290.     macro    function major=0, minor=0
  291.     major=$major
  292.     minor=$minor
  293.  
  294.     if typeof major != 1
  295.       warning XLIB major `$major' is not integer
  296.     endif
  297.  
  298.     if typeof minor != 1
  299.       warning XLIB minor `$minor' is not integer
  300.     endif
  301.  
  302.     data.a    type_xlib
  303.     data.3    major, minor
  304.     endmacro        
  305.  
  306.     xlib = function
  307.  
  308.     hide    xlib, function
  309.  
  310. ; Type Real
  311.  
  312.     macro real r=`0.0'
  313.  
  314.     r = $r
  315.  
  316.     if (typeof r != 4) && (typeof r != 1)
  317.       warning `$r' is neither real nor integer
  318.     endif
  319.  
  320.     data.a    type_real
  321.     double    r
  322.     endmacro
  323.  
  324.     hide    real
  325.  
  326. ; Complex
  327.  
  328.     macro complex re=`0.0',im=`0.0'
  329.  
  330.     re=$re
  331.     im=$im
  332.  
  333.     if (typeof re != 4) && (typeof re != 1)
  334.       warning Real part `$re' is neither real nor integer
  335.     endif
  336.  
  337.     if (typeof im != 4) && (typeof im != 1)
  338.       warning Imaginary part `$im' is neither real nor integer
  339.     endif
  340.  
  341.     data.a    type_complex
  342.     double    re, im
  343.     endmacro
  344.  
  345.     hide    complex
  346.  
  347. ; String
  348.  
  349.     macro string str=``''
  350.  
  351.     str=$str
  352.  
  353.     if typeof str != 2
  354.       warning `$str' is not string
  355.     endif
  356.  
  357.     data.a    type_string
  358.     data.a    sz^str * 2 + 5
  359.     ascii    str
  360.  
  361.     endmacro
  362.  
  363.     hide    string
  364.  
  365. ; Global name
  366.  
  367.     macro global name=``''
  368.  
  369.     name=$name
  370.  
  371.     if typeof name != 2
  372.       warning `$name' is not string
  373.     endif
  374.  
  375.     data.a    type_global
  376.     data.b    sz^name
  377.     ascii    name
  378.  
  379.     endmacro
  380.  
  381.     hide    global
  382.  
  383. ; Local name
  384.  
  385.     macro local name=``''
  386.  
  387.     name=$name
  388.  
  389.     if typeof name != 2
  390.       warning `$name' is not string
  391.     endif
  392.  
  393.     data.a    type_local
  394.     data.b    sz^name
  395.     ascii    name
  396.  
  397.     endmacro
  398.  
  399.     hide    local
  400.  
  401. ; Binary
  402.  
  403.     macro binary value=0, digits=16
  404.  
  405.     digits=$digits
  406.     value=$value
  407.  
  408.     if typeof value != 1
  409.       warning `$value' is not integer
  410.     endif
  411.  
  412.     data.a    type_binary
  413.     data.a    digits+5
  414.  
  415.     data.$digits value
  416.  
  417.     endmacro
  418.  
  419.     hide    binary
  420.  
  421. ; Short/address
  422.  
  423.     macro short s=0
  424.  
  425.     s = $s
  426.     
  427.     if typeof s != 1
  428.       warning `$s' is not integer
  429.     endif
  430.  
  431.     data.a    type_short, s
  432.  
  433.     endmacro
  434.  
  435.     ; Alias
  436.  
  437.     address = short
  438.     sysbin = short
  439.  
  440.     hide    address, short, sysbin
  441.  
  442. ; Character
  443.  
  444.     macro character ch=0
  445.  
  446.     ch=$ch
  447.  
  448.     if (typeof ch != 1) && (typeof ch != 2)
  449.       warning $ch is neither integer nor string
  450.     endif
  451.  
  452.     data.a    type_character
  453.     data.b    ch
  454.     endmacro
  455.  
  456.     hide    character
  457.  
  458. ;
  459.     hp48loaded=true
  460.     hide    hp48loaded
  461.  
  462.     endif    ; pass == 1
  463.     
  464.     .=x'70000
  465.  
  466.     endlist
  467.